home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Night Owl 6-1
/
Night Owl's Shareware - PDSI-006-1 - Night Owl Corp (1992).iso
/
033a
/
mfm_109b.arj
/
COPYMOVE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-06-20
|
17KB
|
465 lines
{========================================================================}
Procedure CenterWrite(Row : Byte; CenteredString : String);
Begin
AnsiGotoXY(Row,1); AnsiClearToEOL;
AnsiGotoXY(Row,40-(Length(CenteredString) Div 2));
Write(CenteredString);
End;
{========================================================================}
Function FileCopy(FromFileName, ToFileName : String; CopyOrMove : Char) : Boolean;
Var
FromFile, ToFile : File;
OverWrite : Boolean;
Fcc : Char;
TempEntry : ListPtr;
ToFilesBbs : Text;
Begin
FileCopy := False; OverWrite := True;
FindFirst(FromFileName,AnyFile,DirInfo);
If DosError = 0 Then
Begin
FindFirst(ToFileName,AnyFile,DirInfo);
If DosError = 0 Then
Begin
OverWrite := False;
AnsiClearScreen; AnsiGotoXY(21,1);
NewTextColor(Black); NewTextBackground(Cyan);
Write(Pgmid+' ^Q=quit ?=help');
NewTextColor(White); NewTextBackground(Black);
NextPrintEntry := CurrentEntry; DisplayRecord(22);
NewTextColor(White);
CenterWrite(23,'already exists as');
New(TempEntry);
TempEntry^.TypeOfRecord := FileRecord;
TempEntry^.FileName := DirInfo.Name;
TempEntry^.FileDate := DirInfo.Time;
TempEntry^.FileSize := DirInfo.Size;
Fsplit(ToFileName,D,N,E);
Assign(ToFilesBbs,D+'FILES.BBS');
{$I-} Reset(ToFilesBbs); {$I+}
If IOresult = 0 Then
Begin
While (Not Eof(ToFilesBbs)) Do
Begin
ReadLn(ToFilesBbs,WorkString);
If Pos(N+E,WorkString) > 0 Then
Begin
TempEntry^.Description := Copy(WorkString,Pos(' ',WorkString)+1,Length(WorkString)-Pos(' ',WorkString));
End;
End;
Close(ToFilesBbs);
End
Else
Begin
TempEntry^.Description := '';
End;
TempEntry^.Tagged := False;
NextPrintEntry := TempEntry; DisplayRecord(24);
Dispose(TempEntry);
NewTextColor(White);
CenterWrite(25,'Overwrite? (Y/N) ');
Repeat
Gbx := GetInput;
Fcc := Upcase(Chr(Gbx));
Until Fcc In ['N','Y'];
Write(Fcc);
If Fcc = 'Y' Then OverWrite := True;
End;
If OverWrite Then
Begin
If (CopyOrMove = 'M') And (Copy(FromFileName,1,1) = Copy(ToFileName,1,1)) Then
Begin
CenterWrite(22,'Moving');
CenterWrite(23,FromFileName);
CenterWrite(24,'to');
CenterWrite(25,ToFileName);
FindFirst(ToFileName,AnyFile,DirInfo);
If DosError = 0 Then
Begin
Assign(ToFile,ToFileName);
Erase(ToFile);
End;
Assign(FromFile,FromFileName);
Rename(FromFile,ToFileName);
End
Else
Begin
If CopyOrMove = 'C' Then CenterWrite(22,'Copying ') Else CenterWrite(22,'Moving ');
CenterWrite(23,FromFileName);
CenterWrite(24,'to');
CenterWrite(25,ToFileName);
DoFileCopy(FromFileName,ToFileName);
Assign(FromFile,FromFileName);
If CopyOrMove = 'M' Then Erase(FromFile);
End;
FileCopy := True;
End;
End;
End;
{========================================================================}
Procedure ShowSizeSpace(Drive : Char; Row : Byte);
Begin
Drive := UpCase(Drive);
AnsiGotoXY(Row,1);
NewTextColor(Black);
NewTextBackground(Cyan);
AnsiClearToEol;
Write(CurrentEntry^.FileName+' is ',CurrentEntry^.FileSize Div 1024,'K bytes in size! There are ');
Write(DiskFree(Ord(Drive)-64) Div 1024);
Write('K bytes free on drive '+Drive+'.');
NewTextColor(White); NewTextBackground(Black);
End;
{========================================================================}
Procedure CopyFile;
Var
ToAreaPath : String[80];
Cfc : Char;
Begin
If CurrentEntry^.TypeOfRecord = FileRecord Then
Begin
SetupScreen;
AnsiGotoXY(25,1); AnsiClearToEOL;
Write(FileAreaPath+CurrentEntry^.FileName);
ToAreaPath := ChooseArea;
If ToAreaPath <> 'QUIT' Then
Begin
ShowSizeSpace(ToAreaPath[1],24);
If CurrentEntry^.FileSize < (DiskFree(Ord(UpCase(ToAreaPath[1]))-64)-(SizeOfFilesBbs(ToAreaPath)+2048)) Then
Begin
ShowSizeSpace(ToAreaPath[1],21);
CenterWrite(22,FileAreaPath+CurrentEntry^.FileName);
CenterWrite(23,'to');
CenterWrite(24,ToAreaPath+CurrentEntry^.FileName);
CenterWrite(25,'Proceed with COPY? (Y/N) ');
Repeat
Gbx := GetInput;
Cfc := Upcase(Chr(Gbx));
Until Cfc In ['N','Y'];
Write(Cfc);
If Cfc = 'Y' Then
Begin
If FileCopy(FileAreaPath+CurrentEntry^.FileName,ToAreaPath+CurrentEntry^.FileName,'C') Then
Begin
FindFirst(ToAreaPath+'FILES.BBS',AnyFile,DirInfo);
If DosError = 0 Then
Begin
Changed := False;
Assign(FileList,ToAreaPath+'FILES.BBS');
Reset(FileList);
Assign(NewFileList,ToAreaPath+'FILES.NEW');
Rewrite(NewFileList);
While (Not Eof(FileList)) Do
Begin
ReadLn(FileList,WorkString);
If Pos(CurrentEntry^.FileName,WorkString) = 0 Then
Begin
WriteLn(NewFileList,WorkString);
End
Else
Begin
WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
Changed := True;
End;
End;
If (Not Changed) Then WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
Close(FileList); Close(NewFileList);
Erase(FileList); Rename(NewFileList,ToAreaPath+'FILES.BBS');
End
Else
Begin
Assign(FileList,ToAreaPath+'FILES.BBS');
ReWrite(FileList);
WriteLn(FileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
Close(FileList);
End;
End;
End;
ReDrawScreen;
End
Else
Begin
ReDrawScreen;
AnsiGotoXY(25,1); AnsiClearToEOL;
Write('There is not enough space on drive '+ToAreaPath[1]+' to complete the copy!');
End;
End
Else ReDrawScreen;
End;
End;
{========================================================================}
Procedure MoveFile;
Var
ToAreaPath : String[80];
Mfc : Char;
FileToErase : File;
Begin
If CurrentEntry^.TypeOfRecord = FileRecord Then
Begin
SetupScreen;
AnsiGotoXY(25,1); AnsiClearToEOL;
Write(FileAreaPath+CurrentEntry^.FileName);
ToAreaPath := ChooseArea;
If ToAreaPath <> 'QUIT' Then
Begin
ShowSizeSpace(ToAreaPath[1],24);
If (CurrentEntry^.FileSize < (DiskFree(Ord(UpCase(ToAreaPath[1]))-64))-(SizeOfFilesBbs(ToAreaPath)+2048))
Or (FileAreaPath[1] = ToAreaPath[1]) Then
Begin
ShowSizeSpace(ToAreaPath[1],21);
CenterWrite(22,FileAreaPath+CurrentEntry^.FileName);
CenterWrite(23,'to');
CenterWrite(24,ToAreaPath+CurrentEntry^.FileName);
CenterWrite(25,'Proceed with MOVE? (Y/N) ');
Repeat
Gbx := GetInput;
Mfc := Upcase(Chr(Gbx));
Until Mfc In ['N','Y'];
Write(Mfc);
If Mfc = 'Y' Then
Begin
If FileCopy(FileAreaPath+CurrentEntry^.FileName,ToAreaPath+CurrentEntry^.FileName,'M') Then
Begin
FindFirst(ToAreaPath+'FILES.BBS',AnyFile,DirInfo);
If DosError = 0 Then
Begin
Changed := False;
Assign(FileList,ToAreaPath+'FILES.BBS');
Reset(FileList);
Assign(NewFileList,ToAreaPath+'FILES.NEW');
Rewrite(NewFileList);
While (Not Eof(FileList)) Do
Begin
ReadLn(FileList,WorkString);
If Pos(CurrentEntry^.FileName,WorkString) = 0 Then
Begin
WriteLn(NewFileList,WorkString);
End
Else
Begin
WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
Changed := True;
End;
End;
If (Not Changed) Then WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
Close(FileList); Close(NewFileList);
Erase(FileList); Rename(NewFileList,ToAreaPath+'FILES.BBS'); End
Else
Begin
Assign(FileList,ToAreaPath+'FILES.BBS');
ReWrite(FileList);
WriteLn(FileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
Close(FileList);
End;
PushRecord(KillEntry);
OldEntry := KillEntry;
If KillEntry^.PrevEntry = KillEntry Then
Begin
Dispose(KillEntry);
KillEntry := NIL;
End
Else
Begin
KillEntry^.PrevEntry^.NextEntry := KillEntry^.NextEntry;
KillEntry^.NextEntry^.PrevEntry := KillEntry^.PrevEntry;
KillEntry := KillEntry^.NextEntry;
End;
If KillEntry <> NIL Then Dispose(OldEntry);
End;
End;
ReDrawScreen;
End
Else
Begin
ReDrawScreen;
AnsiGotoXY(25,1); AnsiClearToEOL;
Write('There is not enough space on drive '+ToAreaPath[1]+' to complete the move!');
End;
End
Else ReDrawScreen;
End;
End;
{========================================================================}
Procedure MassMove;
Var
ToAreaPath : String[80];
TempEntry : ListPtr;
Mmc : Char;
MoveOk : Boolean;
Begin
SetupScreen;
CenterWrite(25,'Select area to MASS MOVE to...');
ToAreaPath := ChooseArea;
If ToAreaPath <> 'QUIT' Then
Begin
CenterWrite(25,'Proceed with MASS MOVE? (Y/N) ');
Repeat
Gbx := GetInput;
Mmc := Upcase(Chr(Gbx));
Until Mmc In ['N','Y'];
Write(Mmc);
If Mmc = 'Y' Then
Begin
TempEntry := CurrentEntry;
CurrentEntry := FirstEntry;
While CurrentEntry^.NextEntry <> NIL Do
Begin
MoveOk := False;
If CurrentEntry^.Tagged Then
Begin
ShowSizeSpace(ToAreaPath[1],24);
If (CurrentEntry^.FileSize < (DiskFree(Ord(UpCase(ToAreaPath[1]))-64))-(SizeOfFilesBbs(ToAreaPath)+2048))
Or (FileAreaPath[1] = ToAreaPath[1]) Then
Begin
ShowSizeSpace(ToAreaPath[1],21);
If FileCopy(FileAreaPath+CurrentEntry^.FileName,ToAreaPath+CurrentEntry^.FileName,'M') Then
Begin
FindFirst(ToAreaPath+'FILES.BBS',AnyFile,DirInfo);
If DosError = 0 Then
Begin
Changed := False;
Assign(FileList,ToAreaPath+'FILES.BBS');
Reset(FileList);
Assign(NewFileList,ToAreaPath+'FILES.NEW');
Rewrite(NewFileList);
While (Not Eof(FileList)) Do
Begin
ReadLn(FileList,WorkString);
If Pos(CurrentEntry^.FileName,WorkString) = 0 Then
Begin
WriteLn(NewFileList,WorkString);
End
Else
Begin
WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
Changed := True;
End;
End;
If (Not Changed) Then WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
Close(FileList); Close(NewFileList);
Erase(FileList); Rename(NewFileList,ToAreaPath+'FILES.BBS');
End
Else
Begin
Assign(FileList,ToAreaPath+'FILES.BBS');
ReWrite(FileList);
WriteLn(FileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
Close(FileList);
End;
MoveOk := True;
PushRecord(KillEntry);
OldEntry := KillEntry;
If KillEntry^.PrevEntry = KillEntry Then
Begin
Dispose(KillEntry);
KillEntry := NIL;
End
Else
Begin
KillEntry^.PrevEntry^.NextEntry := KillEntry^.NextEntry;
KillEntry^.NextEntry^.PrevEntry := KillEntry^.PrevEntry;
KillEntry := KillEntry^.NextEntry;
End;
If KillEntry <> NIL Then Dispose(OldEntry);
End;
End
Else
Begin
ReDrawScreen;
AnsiGotoXY(25,1); AnsiClearToEOL;
Write('There is not enough space on drive '+ToAreaPath[1]+' to complete the move!');
End;
End;
If (Not MoveOk) Then CurrentEntry := CurrentEntry^.NextEntry;
End;
End;
End;
CurrentEntry := TopEntry; Row := 1;
SetupScreen; DisplayScreen;
End;
{========================================================================}
Procedure MassCopy;
Var
ToAreaPath : String[80];
TempEntry : ListPtr;
Mcc : Char;
CopyOk : Boolean;
Begin
SetupScreen;
CenterWrite(25,'Select area to MASS COPY to...');
ToAreaPath := ChooseArea;
If ToAreaPath <> 'QUIT' Then
Begin
CenterWrite(25,'Proceed with MASS COPY? (Y/N) ');
Repeat
Gbx := GetInput;
Mcc := Upcase(Chr(Gbx));
Until Mcc In ['N','Y'];
Write(Mcc);
If Mcc = 'Y' Then
Begin
TempEntry := CurrentEntry;
CurrentEntry := FirstEntry;
While CurrentEntry^.NextEntry <> NIL Do
Begin
CopyOk := False;
If CurrentEntry^.Tagged Then
Begin
ShowSizeSpace(ToAreaPath[1],24);
If (CurrentEntry^.FileSize < (DiskFree(Ord(UpCase(ToAreaPath[1]))-64))-(SizeOfFilesBbs(ToAreaPath)+2048))
Or (FileAreaPath[1] = ToAreaPath[1]) Then
Begin
ShowSizeSpace(ToAreaPath[1],21);
If FileCopy(FileAreaPath+CurrentEntry^.FileName,ToAreaPath+CurrentEntry^.FileName,'C') Then
Begin
FindFirst(ToAreaPath+'FILES.BBS',AnyFile,DirInfo);
If DosError = 0 Then
Begin
Changed := False;
Assign(FileList,ToAreaPath+'FILES.BBS');
Reset(FileList);
Assign(NewFileList,ToAreaPath+'FILES.NEW');
Rewrite(NewFileList);
While (Not Eof(FileList)) Do
Begin
ReadLn(FileList,WorkString);
If Pos(CurrentEntry^.FileName,WorkString) = 0 Then
Begin
WriteLn(NewFileList,WorkString);
End
Else
Begin
WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
Changed := True;
End;
End;
If (Not Changed) Then WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
Close(FileList); Close(NewFileList);
Erase(FileList); Rename(NewFileList,ToAreaPath+'FILES.BBS');
End
Else
Begin
Assign(FileList,ToAreaPath+'FILES.BBS');
ReWrite(FileList);
WriteLn(FileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
Close(FileList);
End;
CopyOk := True;
End;
End
Else
Begin
ReDrawScreen;
AnsiGotoXY(25,1); AnsiClearToEOL;
Write('There is not enough space on drive '+ToAreaPath[1]+' to complete the copy!');
End;
End;
CurrentEntry^.Tagged := False;
If (Not CopyOk) Then CurrentEntry := CurrentEntry^.NextEntry;
End;
End;
End;
CurrentEntry := TopEntry; Row := 1;
SetupScreen; DisplayScreen;
End;
{========================================================================}